Nautilus 1992 July/Nautilus-3-8/Nautilus-3-8.bin/Tools & Utilities/Hacks Pt.1 ƒ/3D Bouncing Ball AD Module/3DBouncingBall.p

Text File | 1992-06-18 | 15.1 KB | 559 lines

{3D Bouncing Ball Module}
{Written by Daniel C. Stegman, Exodus Software}
{⌐1992, Exodus Software, All Rights Reserved.}
{This code is intended for use as a After Dark 2.0 ScreenSaver Module.  It is intended for entertainment}
{use, and for the enlightenment of programmers.  It uses fixed math to optimize all of it's 3D calculations,}
{and uses Color on those macs that can support it.  Enjoy!!}
{Dedicated to the Hackers of MacHack, 1992}

unit GraphicsDemo;

interface

    uses
        MemTypes, Memory, Packages, FixMath, Quickdraw, Sound, ToolIntf, GraphicsModuleTypes, FixedThreeDeeCalls;

CONST
    kRedColor            = 1;
    kBlueColor        = 2;
    kGreenColor        = 3;
    kPurpleColor        = 4;
    kYellowColor    = 5;
    kOrangeColor    = 6;
    kWhiteColor        = 7;

TYPE
    rectArray = array [1..10] of rect;
    theBall = RECORD
        its3DLoc        : ThreeDeePoint;
        itsShadow        : ThreeDeePoint;
        its2DLoc        : point;
        sh2DLoc        : point;
        oldRect            : rect;
        Old2DRects    : rectArray;
        Oldsh2DRects: rectArray;
        bounceCount    : integer;
        xVector        : fixed;
        yVector        : fixed;
        zVector        : fixed;
        itsColor        : RGBColor;
        colorCode        : integer;
        gravity            : integer;
        speed            : integer;
        shadowVis    : boolean;
    end;

    ballArray = array[1..5] of theBall;

    tempStorage = RECORD
        aBall                : theBall;
        bBall                : theBall;
        cBall                : theBall;
        dBall                : theBall;
        eBall                : theBall;
        doColor            : boolean;
        forceGray        : boolean;
        kWhiteRGB    : RGBColor;
        kGrayRGB        : RGBColor;
        kBlackRGB    : RGBColor;
        RotaryColor    : integer;
        numballs        : integer;
        theBalls        : ballArray;
        aBox                : ThreeDeeWorld;
    end;
    tempPtr    = ^tempStorage;
    tempHdl    = ^tempPtr;

{    integerPtr            = ^integer;    }
    integerHandle        = ^integerPtr;
    booleanPtr            = ^boolean;
    booleanHandle        = ^booleanPtr;

    function DoInitialize (var storage: Handle; blankRgn: rgnHandle; params: GMParamBlockPtr): OSErr;
    function DoBlank (storage: Handle; blankRgn: rgnHandle; params: GMParamBlockPtr): OSErr;
    function DoDrawFrame (storage: Handle; blankRgn: rgnHandle; params: GMParamBlockPtr): OSErr;
    function DoClose (storage: Handle; blankRgn: RgnHandle; params: GMParamBlockPtr): OSErr;
    function DoSetup (blankRgn: rgnHandle; message: integer; params: GMParamBlockPtr): OSErr;

IMPLEMENTATION

PROCEDURE InitializeArray(VAR itsRectArray : rectArray);
    VAR
        count        : integer;
BEGIN
    For count := 1 to 10
        do SetRect(itsRectArray[count], 1, 1, 1, 1);
END;

PROCEDURE ShiftArray(VAR itsRectArray : rectArray);
    VAR
        count        : integer;
BEGIN
    For count := 9 downto 1
        do itsRectArray[count + 1] := itsRectArray[count];
END;

PROCEDURE InitBall(var ballA : theBall; boxA : ThreeDeeWorld; doColor, forceGray : boolean; params: GMParamBlockPtr);
    VAR
        two                : fixed;
        eightTenths    : fixed;
        tempFixed        : fixed;
        newColor        : integer;

    FUNCTION ReturnMagicColor(tempValue : integer): RGBColor;
        VAR
            tempColor        : RGBColor;
            newColor        : integer;
    BEGIN
        tempColor.red := 0;
        tempColor.green := 0;
        tempColor.blue := 0;
        case tempValue of
            kRedColor:
                begin
                    tempColor.red := -1;
                end;
            kBlueColor:
                begin
                    tempColor.blue := -1;
                end;
            kGreenColor:
                begin
                    tempColor.green := -1;
                end;
            kPurpleColor:
                begin
                    tempColor.red := -1;
                    tempColor.blue := -1;
                end;
            kYellowColor:
                begin
                    tempColor.red := -1;
                    tempColor.green := -1;
                end;
            kOrangeColor:
                begin
                    tempColor.red := -1;
                    tempColor.green := 32767;
                end;
            otherwise
                begin
                    tempColor.red := -1;
                    tempColor.blue := -1;
                    tempColor.green := -1;
                end;
        end;
        ReturnMagicColor := tempColor;
    END;
BEGIN
    with ballA, boxA do begin
        two := Long2Fix(2);
        eightTenths := X2Fix(0.8);

        with params^ do begin
            gravity := controlValues[0];
            speed := controlValues[1] + 1;
            shadowVis := (controlValues[3] <> 0);
        end;

    {    gravity := 20;
        speed := 40;
        shadowVis := TRUE;    }
        tempFixed := frontTopRight.x - frontTopLeft.x;

        its3DLoc.x := FixDiv(tempFixed, two);
        its3DLoc.y := frontTopLeft.y;
        its3DLoc.z := its3DLoc.x;
        xVector := Long2Fix(random mod speed);
        yVector := Long2Fix(abs(random mod speed));
        zVector := Long2Fix(random mod speed);
        IF doColor
            THEN BEGIN
                IF forceGray
                    THEN newColor := kWhiteColor
                    ELSE newColor := random mod 7;
                itsColor := ReturnMagicColor(newColor);
                colorCode := newColor;
            END;
        {    Cannon Settings    }
    {    its3DLoc.x := FixDiv(tempFixed, two);
        its3DLoc.y := FixMul((frontBotLeft.y - frontTopLeft.y), eightTenths);
        its3DLoc.z := frontBotLeft.z;
        xVector := Long2Fix(random mod speed);
        yVector := Long2Fix(- abs(random mod 30));
        zVector := Long2Fix(40 + abs(random mod 30));    }

        bounceCount := 0;
    end;
END;

FUNCTION DoInitialize (var storage: Handle; blankRgn: rgnHandle; params: GMParamBlockPtr): OSErr;
    {Allocate memory and initialize variables here}
    VAR
        index    : integer;
        aHdl        : tempHdl;
        bHdl        : Handle;
        aRect    : rect;
        two        : fixed;
        tempFixed    : fixed;
BEGIN
    aHdl := tempHdl(NewHandle(sizeof(tempStorage)));
    if aHdl <> nil
        then begin
            aRect := params^.monitors^.monitorList[0].bounds;
            SetupThreeDeeWorld (aHdl^^.aBox, aRect);

            with aHdl^^, aBall, aBox do begin
                doColor := (params^.colorQDAvail) and (params^.monitors^.monitorList[0].curDepth > 2);
                forceGray := params^.monitors^.monitorList[0].curDepth = 4;
                numballs := (params^.controlValues[2] div 20) + 1;
                IF numBalls > 5
                    THEN numBalls := 5;

                kWhiteRGB.red := -1;
                kWhiteRGB.green := -1;
                kWhiteRGB.blue := -1;
                kGrayRGB.red := 32767;
                kGrayRGB.green := 32767;
                kGrayRGB.blue := 32767;
                kBlackRGB.red := 0;
                kBlackRGB.green := 0;
                kBlackRGB.blue := 0;

                RotaryColor := 1;

                For index := 1 to numBalls
                    do begin
                        InitializeArray(theBalls[index].Old2DRects);
                        InitializeArray(theBalls[index].OldSH2DRects);
                        InitBall(theBalls[index], aBox, doColor, forceGray, params);
                        RotaryColor := RotaryColor + 1;
                    end;

                FillRect(aBox.screenRect, params^.qdGlobalsCopy^.qdBlack);
            end;
            storage := handle(aHdl);
            DoInitialize := noErr;
        end
    else DoInitialize := MemError;
END;

FUNCTION DoBlank (storage: Handle; blankRgn: rgnHandle; params: GMParamBlockPtr): OSErr;
    {Blank the screen.  You could also have "credits" appear on the screen here}
BEGIN
    FillRgn(blankRgn, params^.qdGlobalsCopy^.qdBlack);
    DoBlank := noErr;
END;

FUNCTION MoveBall (var ballA : theBall; boxA : ThreeDeeWorld; doColor, forceGray : boolean; params: GMParamBlockPtr): boolean;
    VAR
        tempFixed    : fixed;
        two            : fixed;
        anErr        : OSErr;
BEGIN
    with ballA, boxA do begin
        { Update the location by applying the vectors }
        its3DLoc.x := its3DLoc.x + xVector;
        its3DLoc.y := its3DLoc.y + yVector;
        its3DLoc.z := its3DLoc.z + zVector;
        yVector := yVector + X2Fix(gravity / 20);

        {    Check for out of bounds    }
        IF (its3DLoc.x <= frontTopLeft.x)
            THEN BEGIN
                its3DLoc.x := frontTopLeft.x;
                xVector := -xVector;
            END
        ELSE IF (its3DLoc.x >= frontTopRight.x)
            THEN BEGIN
                its3DLoc.x := frontTopRight.x;
                xVector := -xVector;
            END;

        IF (its3DLoc.y <= frontTopLeft.y)
            THEN BEGIN
                its3DLoc.y := frontTopLeft.y;
                yVector := -yVector;
            END
        ELSE IF (its3DLoc.y >= frontBotLeft.y)
            THEN BEGIN
                its3DLoc.y := frontBotLeft.y;
                IF gravity > 0
                    THEN BEGIN
                        yVector := FixMul(-yVector, X2Fix(2/3));
                        xVector := FixMul(xVector, X2Fix(3/4));
                        zVector := FixMul(zVector, X2Fix(3/4));
                    END
                    ELSE BEGIN
                        yVector := -yVector;
                    END;
                bounceCount := bounceCount + 1;
                IF (bounceCount = 8)
                    THEN BEGIN
                        InitBall(ballA, boxA, doColor, forceGray, params);
                    END;
            END;

        IF (its3DLoc.z <= frontTopLeft.z)
            THEN BEGIN
                its3DLoc.z := frontTopLeft.z;
                zVector := -zVector;
            END
        ELSE IF (its3DLoc.z >= backTopRight.z)
            THEN BEGIN
                its3DLoc.z := backTopRight.z;
                zVector := -zVector;
            END;
    end;
END;

PROCEDURE DrawBox (boxA : ThreeDeeWorld; kWhiteRGB, kGrayRGB, kBlackRGB : RGBColor; params : GMParamBlockPtr);
    VAR
        itsRect                : rect;
        tempPt1            : point;
        tempPt2            : point;
BEGIN
    with boxA do begin
        IF params^.colorQDAvail
            THEN RGBForeColor(kGrayRGB)
            ELSE PenPat(params^.qdGlobalsCopy^.qdWhite);

        ThreeDeeToTwoDee(boxA, frontTopLeft, tempPt1);
        ThreeDeeToTwoDee(boxA, frontBotRight, tempPt2);
        SetRect(itsRect, tempPt1.h, tempPt1.v, tempPt2.h, tempPt2.v);
        FrameRect (itsRect);
        ThreeDeeToTwoDee(boxA, backTopLeft, tempPt1);
        ThreeDeeToTwoDee(boxA, BackBotRight, tempPt2);
        SetRect(itsRect, tempPt1.h, tempPt1.v, tempPt2.h, tempPt2.v);
        FrameRect (itsRect);
        ThreeDeeToTwoDee(boxA, frontTopLeft, tempPt1);
        MoveTo (tempPt1.h, tempPt1.v);
        ThreeDeeToTwoDee(boxA, backTopLeft, tempPt1);
        LineTo (tempPt1.h, tempPt1.v);
        ThreeDeeToTwoDee(boxA, frontTopRight, tempPt1);
        MoveTo (tempPt1.h, tempPt1.v);
        ThreeDeeToTwoDee(boxA, backTopRight, tempPt1);
        LineTo (tempPt1.h, tempPt1.v);
        ThreeDeeToTwoDee(boxA, frontBotLeft, tempPt1);
        MoveTo (tempPt1.h, tempPt1.v);
        ThreeDeeToTwoDee(boxA, backBotLeft, tempPt1);
        LineTo (tempPt1.h, tempPt1.v);
        ThreeDeeToTwoDee(boxA, frontBotRight, tempPt1);
        MoveTo (tempPt1.h, tempPt1.v);
        ThreeDeeToTwoDee(boxA, backBotRight, tempPt1);
        LineTo (tempPt1.h, tempPt1.v);
        IF params^.colorQDAvail
            THEN RGBForeColor(kWhiteRGB);
    end;
END;

PROCEDURE UpdateBall (VAR ballA : theBall; aBox : ThreeDeeWorld; kWhiteRGB, kGrayRGB, kBlackRGB : RGBColor; params : GMParamBlockPtr);
    VAR
        itsSize        : integer;
        zDepth        : fixed;
        itsScale    : fixed;
        itsRect        : rect;
        shRect        : rect;
        tempString1    : Str255;
        tempString2    : Str255;

    PROCEDURE RampDownColor(tempColor : RGBColor; colorCode, degradeBy : integer);
        VAR
            degradeVal        : integer;
    BEGIN
    {    degradeVal := trunc(65000 / (1.0 * degradeBy));    }
        degradeVal := 65000 div degradeBy;
        IF params^.colorQDAvail
            THEN BEGIN
                Case colorCode of
                    kRedColor:
                        begin
                            tempColor.red := degradeVal;
                        end;
                    kBlueColor:
                        begin
                            tempColor.blue := degradeVal;
                        end;
                    kGreenColor:
                        begin
                            tempColor.green := degradeVal;
                        end;
                    kPurpleColor:
                        begin
                            tempColor.red := degradeVal;
                            tempColor.blue := degradeVal;
                        end;
                    kYellowColor:
                        begin
                            tempColor.red := degradeVal;
                            tempColor.green := degradeVal;
                        end;
                    kOrangeColor:
                        begin
                            tempColor.red := degradeVal;
                            tempColor.green := degradeVal;            { Make it yellow since Orange fades fast }
                        end;
                    otherwise
                        begin
                            tempColor.red := degradeVal;
                            tempColor.blue := degradeVal;
                            tempColor.green := degradeVal;
                        end;
                end;
                RGBForeColor(tempColor);
            END
            ELSE BEGIN
                CASE degradeBy of
                    1:
                        PenPat(params^.qdGlobalsCopy^.qdWhite);
                    2..4:
                        PenPat(params^.qdGlobalsCopy^.qdLtGray);
                    5..7:
                        PenPat(params^.qdGlobalsCopy^.qdGray);
                    otherwise
                        PenPat(params^.qdGlobalsCopy^.qdDkGray);
                end;
            END;
    END;
BEGIN
    zDepth := abs(aBox.frontTopLeft.z - aBox.backTopLeft.z);
    itsScale := FixDiv((aBox.backTopLeft.z - ballA.its3DLoc.z), aBox.backTopLeft.z);
    itsSize := 4 + Fix2Long(FixMul(itsScale, Long2Fix(20)));

    itsRect.left := ballA.its2DLoc.h - (itsSize div 2);
    itsRect.right := ballA.its2DLoc.h + (itsSize div 2);
    itsRect.top := ballA.its2DLoc.v - (itsSize div 2);
    itsRect.bottom := ballA.its2DLoc.v + (itsSize div 2);
    IF ballA.shadowVis
        THEN BEGIN
            shRect.left := ballA.sh2DLoc.h - (itsSize div 2);
            shRect.right := ballA.sh2DLoc.h + (itsSize div 2);
            shRect.top := ballA.sh2DLoc.v - (itsSize div 4);
            shRect.bottom := ballA.sh2DLoc.v + (itsSize div 4);
        END;

    IF params^.colorQDAvail
        THEN BEGIN
            RGBForeColor(kWhiteRGB);
        END
        ELSE BEGIN
            PenPat(params^.qdGlobalsCopy^.qdWhite);
        END;

    with ballA do begin
    IF params^.colorQDAvail
        THEN BEGIN
            RGBForeColor(kBlackRGB);
            PaintOval(Old2DRects[10]);
            PaintOval(Old2DRects[1]);
            IF shadowVis
                THEN PaintOval(OldSh2DRects[10]);
        END
        ELSE BEGIN
            FillOval(Old2DRects[10], params^.qdGlobalsCopy^.qdBlack);
            FillOval(Old2DRects[1], params^.qdGlobalsCopy^.qdBlack);
            IF shadowVis
                THEN FillOval(OldSh2DRects[10], params^.qdGlobalsCopy^.qdBlack);
        END;

        ShiftArray(Old2DRects);
        Old2DRects[1] := itsRect;
        ShiftArray(OldSh2DRects);
        OldSh2DRects[1] := shRect;

        RampDownColor(itsColor, colorCode, 10);
        FrameOval(Old2DRects[10]);
        RampDownColor(itsColor, colorCode, 9);
        FrameOval(Old2DRects[9]);
        RampDownColor(itsColor, colorCode, 8);
        FrameOval(Old2DRects[8]);
        RampDownColor(itsColor, colorCode, 7);
        FrameOval(Old2DRects[7]);
        RampDownColor(itsColor, colorCode, 6);
        FrameOval(Old2DRects[6]);
        RampDownColor(itsColor, colorCode, 5);
        FrameOval(Old2DRects[5]);
        RampDownColor(itsColor, colorCode, 4);
        FrameOval(Old2DRects[4]);
        RampDownColor(itsColor, colorCode, 3);
        FrameOval(Old2DRects[3]);
        RampDownColor(itsColor, colorCode, 2);
        FrameOval(Old2DRects[2]);
        IF params^.colorQDAvail
            THEN RGBForeColor(itsColor)
            ELSE PenPat(params^.qdGlobalsCopy^.qdWhite);
        PaintOval(Old2DRects[1]);

        IF shadowVis
            THEN BEGIN
                RampDownColor(itsColor, colorCode, 10);
                FrameOval(OldSh2DRects[10]);
                RampDownColor(itsColor, colorCode, 9);
                FrameOval(OldSh2DRects[9]);
                RampDownColor(itsColor, colorCode, 8);
                FrameOval(OldSh2DRects[8]);
                RampDownColor(itsColor, colorCode, 7);
                FrameOval(OldSh2DRects[7]);
                RampDownColor(itsColor, colorCode, 6);
                FrameOval(OldSh2DRects[6]);
                RampDownColor(itsColor, colorCode, 5);
                FrameOval(OldSh2DRects[5]);
                RampDownColor(itsColor, colorCode, 4);
                FrameOval(OldSh2DRects[4]);
                RampDownColor(itsColor, colorCode, 3);
                FrameOval(OldSh2DRects[3]);
                RampDownColor(itsColor, colorCode, 2);
                FrameOval(OldSh2DRects[2]);
                IF params^.colorQDAvail
                    THEN RGBForeColor(itsColor)
                    ELSE PenPat(params^.qdGlobalsCopy^.qdWhite);
                FrameOval(OldSh2DRects[1]);
            END;
    end;
END;

FUNCTION DoDrawFrame (storage: Handle; blankRgn: rgnHandle; params: GMParamBlockPtr): OSErr;
    {This function is repeatedly called by After Dark.  This is where the main drawing is done.}
    VAR
        aHdl            : tempHdl;
        movement    : boolean;
        index        : integer;
        waited        : longint;
BEGIN
    aHdl := tempHdl(storage);
    with aHdl^^ do begin

        For index := 1 to numBalls
            do begin
                movement := MoveBall(theBalls[index], aBox, doColor, forceGray, params);
                ThreeDeeToTwoDee(aBox, theBalls[index].its3DLoc, theBalls[index].its2DLoc);
                theBalls[index].itsShadow := theBalls[index].its3DLoc;
                theBalls[index].itsShadow.y := aBox.frontBotRight.y;
                ThreeDeeToTwoDee(aBox, theBalls[index].itsShadow, theBalls[index].sh2DLoc);
                UpdateBall(theBalls[index], aBox, kWhiteRGB, kGrayRGB, kBlackRGB, params);
            end;

        DrawBox (aBox, kWhiteRGB, kGrayRGB, kBlackRGB, params);
    end;
    DoDrawFrame := noErr;
END;

FUNCTION DoClose (storage: Handle; blankRgn: RgnHandle; params: GMParamBlockPtr): OSErr;
    {Deallocate your memory here.  You can also put something on the screen.}
BEGIN
    IF params^.colorQDAvail
        THEN BEGIN
            RGBForeColor(tempHdl(storage)^^.kWhiteRGB);
            RGBBackColor(tempHdl(storage)^^.kBlackRGB);
        END;
    DisposHandle(storage);
    DoClose := noErr;
END;

FUNCTION DoSetup (blankRgn: rgnHandle; message: integer; params: GMParamBlockPtr): OSErr;
    {This is called when the user clicks on a button in the Control Panel.}
BEGIN
    DoSetup := noErr;
END;

END.